(define-module (user-input-output)
  #:use-module (ice-9 textual-ports)
  #:use-module (ice-9 optargs)
  #:use-module (srfi srfi-1)
  #:export (read-line
            write-string
            remove-whitespace-chars
            ask-user
            ask-user-for-character
            ask-user-for-number
            ask-user-for-integer-number
            ask-user-for-yes-no-decision))

;; Using the recommended Textual I/O described in:
;; https://www.gnu.org/software/guile/manual/html_node/Textual-I_002fO.html#Textual-I_002fO

(define (read-line)
  (get-line (current-input-port)))


(define (write-string string)
  (define port (current-output-port))
  (put-string port string))


(define (remove-whitespace-chars string)
  (string-delete (lambda (char)
                   (memq char '(#\newline #\tab #\return #\space)))
                 string))


(define* (ask-user question pred
                   #:key
                   (input-cleanup-proc remove-whitespace-chars)
                   (possible-answers #f)
                   (q-a-separator ": ")
                   (invalid-input-message "Invalid input.\n"))

  (define (write-question question possible-answers q-a-separator)
    (write-string question)
    (if possible-answers
        (write-string (string-append " " "(" (string-join possible-answers "/") ")"))
        (write-string ""))
    (write-string q-a-separator))

  (write-question question possible-answers q-a-separator)
  (let* ([input (read-line)]
         [cleaned-input (input-cleanup-proc input)])
    (cond [(pred cleaned-input)
           (cond [possible-answers
                  (cond [(member cleaned-input possible-answers) cleaned-input]
                        [else
                         (write-string invalid-input-message)
                         (ask-user question
                                   pred
                                   #:input-cleanup-proc input-cleanup-proc
                                   #:possible-answers possible-answers
                                   #:q-a-separator q-a-separator
                                   #:invalid-input-message invalid-input-message)])]
                 [else cleaned-input])]
          [else (write-string invalid-input-message)
                (ask-user question
                          pred
                          #:input-cleanup-proc input-cleanup-proc
                          #:possible-answers possible-answers
                          #:q-a-separator q-a-separator
                          #:invalid-input-message invalid-input-message)])))


(define* (ask-user-for-character question char-pred
                                 #:key
                                 (invalid-input-message "Invalid input. Enter a character.\n"))
  (ask-user question
            (λ (input)
              (and (= (string-length input) 1)
                   (char-pred (car (string->list input)))))
            #:invalid-input-message invalid-input-message))

(define (ask-user-for-number question number-pred)
  (string->number
   (ask-user question
             (lambda (input)
               (and (string->number input)
                    (number-pred (string->number input)))))))


(define (ask-user-for-integer-number question number-pred)
  (ask-user-for-number question (λ (num) (and (number-pred num)
                                              (integer? num)))))


(define (ask-user-for-yes-no-decision question positive-answers negative-answers)
  (let ([user-input
         (ask-user question
                   (λ (input)
                     (member input (lset-union string=? positive-answers negative-answers)))
                   #:possible-answers (reverse (lset-union string=?
                                                           positive-answers
                                                           negative-answers)))])
    (member user-input positive-answers)))
